#lang racket


(require "../base/main.rkt")

(require "domain.rkt"
         "segment.rkt"
         "parametric.rkt"
         "patch.rkt")

(provide cut
         coords)


(define (segmentate-domains curve domains)
  (map (cλ make-segment curve) domains))

(define (patch-domains surface domains)
  (map (cλ make-patch surface) domains))

(define (cut parametric n-domains (cut-fn #f))
  (let ((domain (parametric-domain parametric)))
    (cond ((t-domain? domain)
           (let* ((cut-fn (or cut-fn (cut-fn-linear)))
                  (domains (cut-domain domain n-domains cut-fn)))
             (segmentate-domains parametric domains)))
          ((uv-domain? domain)
           (let* ((cut-fn (or cut-fn (list (cut-fn-linear) (cut-fn-linear))))
                  (domains (cut-domain domain n-domains cut-fn)))
             (patch-domains parametric domains)))
          (else
           (error 'cut "Unhandled domain type")))))

(define (coords parametric n-coords (space-fn parametric-object) (coords-fn #f))
  (let ((domain (parametric-domain parametric))
        (space-fn (space-fn parametric)))
    (cond ((t-domain? domain)
           (let ((coords-fn (or coords-fn (coords-fn-min))))
             (coords-domain (parametric-domain parametric) n-coords space-fn coords-fn)))
          ((uv-domain? domain)
           (let ((coords-fn (or coords-fn (list (coords-fn-min) (coords-fn-min)))))
             (coords-domain (parametric-domain parametric) n-coords space-fn coords-fn)))
          (else
           (error 'coords "Unhandled domain type")))))